perm filename TRANS1[1,JMC] blob
sn#005275 filedate 1970-08-12 generic text, type T, neo UTF8
00100 (DE TRANSFORM (E R DONE) (COND ((MEMBER E DONE) E)
00200 (T ((LAMBDA (W) (COND ((EQ W E) (COND ((ATOM E) E) (T ((LAMBDA (X Y) (COND
00300 ((AND (EQ X (CAR E)) (EQ Y (CDR E))) (SIDE E
00400 (SETQ DONE (CONS E DONE)))) (T (TRANSFORM (CONS X Y) R DONE))))
00500 (TRANSFORM (CAR E) R DONE) (TRANSFORM (CDR E) R DONE)))))
00600 (T (TRANSFORM W R DONE)))) (TRANSA E R)))))
00700
00800 (DE TRANSA (E R) (COND ((NULL R) E) (T
00900 ((LAMBDA (W) (COND ((EQ W E) (TRANSA E (CDR R))) (T W)))
01000 (TRANSB E (CAR R))))))
01100
01200 (DE TRANSB (E RULE) ((LAMBDA (W) (COND ((EQ W (QUOTE NO)) E)
01300 (T (SUBLIS (CADR RULE) W)))) (INST E (CAR RULE) NIL)))
01400
01500 (DE SIDE (X Y) X)
01600
01700 (SETQ R1 (QUOTE (
01800 ((PLUS X.Y) (PLUSA X (PLUS.Y)))
01900 ((PLUSA 0 . X) (PLUSA . X))
02000 ((PLUS.NIL) (PLUSB.NIL))
02100 ((PLUSA X (PLUSB.Y)) (PLUSB X.Y))
02150 ((PLUSA (PLUSB . X)) (PLUSB . X))
02200 )))
02300
02400 (SETQ R2 (QUOTE (
02500 ((PLUS X . Y) (PLUSA X (PLUS .Y)))
02600 ((PLUS . NIL) 0)
02700 ((PLUSA 0 . X) (PLUSA . X))
02800 ((PLUSA) 0)
02900 ((PLUSA X 0) X)
03000 ((PLUSA X) X)
03100 ((PLUSA (PLUSA X . Y) . Z) (PLUSA X (PLUSA . Y) .Z))
03200
03300 ((TIMES X . Y) (TIMESA X (TIMES . Y)))
03400 ((TIMES) 1)
03500 ((TIMESA 1 . X) (TIMESA . X))
03600 ((TIMESA) 1)
03700 ((TIMESA X 1) X)
03800 ((TIMESA X) X)
03900 ((TIMESA (TIMESA X . Y) . Z) (TIMESA X (TIMESA .Y) .Z))
04000
04100 ((TIMES 0 . X) 0)
04200 ((TIMESA 0 . X) 0)
04300 )))
04400